Your Choice 3/Your Choice Software Collection 3.iso/prgmming/swag08/oop.swg

Text File | 1994-09-22 | 30KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00005                                                                           1      08-24-9417:56ALL                      PAB SUNGENIS             TurboVison BUTTONS       SWAG9408    ¼ÿ'S    20     d   π{πButtons are best done in TurboVision or ObjectWindows.  Re-read theπsections dealing with the above in your manual and/or references.ππIf you want to use TurboVision (for the DOS environment), this is a unitπfor a derived object type I created to ease creation of dialog boxes.πYou might want to use it in addition to the TurboVision units:π}ππUnit XBoxes;ππInterfaceππUses Dialogs, Objects, Menus, Views;ππTypeπ  XDialog = Object(TDialog)π     Procedure TxtEntry(x,y : Byte; txt : string; max : Byte);π     Procedure MakeButton(x,y,w: Byte; Txt: string; cmd,mode: Word)π     Procedure OKButton(x,y : Byte);π     Procedure CancelButton(x,y : Byte);π     Procedure Static(x,y : Byte; txt : string);π     Procedure CheckBoxes(x,y,w,z : Byte; Items : PSItem);π  End;π  PXDialog = ^XDialog;ππImplementationππProcedure XDialog.MakeButton(x,y,w: Byte; Txt: string; cmd, mode: Word)π{ Insert a button with the specified text, command, width, and mode atπ  the x,y coordinates in the dialog box }π   R : TRect;π   Temp : PButton;πBegin;π   R.Assign(x,y,x+w,y+2);π   Temp := New(PButton,Init(R,Txt,cmd,mode));π   Insert(Temp);πEnd;ππProcedure XDialog.OKButton(x,y : Byte);π{ Create and insert an 'OK' Button at x,y coordinates }πBegin;π   MakeButton(x,y,10,'~O~K',cmOK,bfDefault);πEnd;ππProcedure XDialog.CancelButton(x,y : Byte);π{ Create and insert a 'Cancel' button }πBegin;π   MakeButton(x,y,10,'Cancel',cmCancel,bfNormal);πEnd;ππProcedure XDialog.TxtEntry(x,y : Byte; txt : string; max : Byte);π{ Create a text entry line and label starting at x,y and expanding toπ  fill the rest of the line in the box. }πVarπ   w : Byte;π   ID : PView;π   R : TRect;πBegin;π   GetExtent(R);π   R.Assign(x+Length(txt)+2,y,R.B.X-2,y+1);π   ID := New(PInputLine,Init(R,max));π   Insert(ID);π   R.Assign(x,y,x+Length(txt)+1,y+1);π   Insert(New(PLabel,Init(R,txt,ID)));πEnd;ππProcedure XDialog.Static(x,y : Byte; txt : string);π{ Static text at x,y }πVarπ   R : TRect;πBegin;π   R.Assign(x,y,x+Length(txt)+1,y+1);π   Insert(New(PStaticText,Init(R,txt)));πEnd;ππProcedure XDialog.CheckBoxes(x,y,w,z : Byte; Items : PSItem);π{ Insert check boxes for cluster 'Items' at x,y with a maximum width ofπ  w and a total of z items. }πVarπ   R : TRect;πBegin;π   R.Assign(x,y,x+(w+3)+1,y+z+1);π   Insert(New(PCheckBoxes,Init(R,Items)));πEnd;ππEnd.π                                                                                                                  2      08-25-9409:07ALL                      RANDALL WOODMAN          String List Object       SWAG9408    KÇ}ε    41     d   UNIT filelist;π{π  Contains Object List for keeping a list of files.π}πINTERFACEπUSES DOS, OPString;ππTYPE  CmdPtr = ^CmdRec;π      CmdRec = RECORDπ          CmdStr : PathStr;  {79 char to allow for maximum path length}π          Next   : CmdPtr;π      end;ππ      List   = OBJECTπ          First, Last, Current : CmdPtr;π          ListCount : Word;ππ          CONSTRUCTOR Init;π          Procedure AddName( Name : String );π          Procedure SortList;π          Procedure SortListReverse;π          Function Compare( A, B : String ) : Boolean;π          Function FirstName : String;π          Function LastName : String;π          Function CurrentName : String;π          Function NextName : String;π          Function TotalCount : Word;π          Procedure ClearList;π          Function InList( Name : String; CheckCase : Boolean ) : Boolean;π          DESTRUCTOR Done;π      END;ππIMPLEMENTATIONππCONSTRUCTOR LIST.INIT;πBEGINπ  FIRST := NIL;π  LAST := NIL;π  CURRENT := NIL;π  LISTCOUNT := 0;πEND;ππPROCEDURE LIST.ADDNAME( NAME : STRING );π  { Add a new CmdRec to the list }πVARπ  TempCmdPtr : CmdPtr;πBEGINπ  NEW(TempCmdPtr);π  If First = NIL then beginπ    First := TempCmdPtr;π    Current := TempCmdPtr;π  end elseπ    Last^.Next := TempCmdPtr;π  TempCmdPtr^.Next := NIL;π  TempCmdPtr^.CmdStr := Name;π  Last := TempCmdPtr;π  INC(ListCount);πEND;ππPROCEDURE LIST.SORTLIST;πVARπ  TempCmdPtr : CmdPtr;π  P, Q : CmdPtr;πBEGINπ  if (First = NIL) or (First^.Next = NIL) then EXIT;π  TempCmdPtr := First;π  First := First^.Next;π  TempCmdPtr^.Next := Nil;ππ  repeatπ     p := TempCmdPtr;ππ     if not Compare( p^.CmdStr, First^.CmdStr ) thenπ        beginπ          TempCmdPtr := First;π          First := First^.Next;π          TempCmdPtr^.Next := p;π        endπ     elseπ     beginπ       while (compare( p^.CmdStr, First^.CmdStr ) ANDπ             (p <> NIL)) doπ       beginπ         q := p;π         p := p^.Next;π       end;ππ       if p = NIL thenπ       beginπ         p := First;π         First := First^.Next;π         q^.Next := p;π         p^.Next := NIL;π       endπ         elseπ       beginπ         q^.next := First;π         First := First^.next;π         q^.next^.next := p;π       end;π     end;π  until First = NIL;ππ  First := TempCmdPtr;π  Current := First;π  Last := First;ππ  repeatπ  Last := Last^.Next;π  until Last^.Next = NIL;ππEND;ππPROCEDURE LIST.SORTLISTREVERSE;πVARπ  TempCmdPtr : CmdPtr;π  CheckPtr   : CmdPtr;π  tempstr    : string;πBEGINπ  if (First = NIL) or (First^.Next = NIL) then EXIT;π  TempCmdPtr := First;π  CheckPtr := First^.Next;ππ  While (TempCmdPtr <> NIL) DOπ  BEGINπ    While (CheckPtr <> NIL) DOπ    BEGINπ      { if the tempcmdptr string is less then the checkptr string }π      If compare(TempCmdPtr^.CmdStr, CheckPtr^.CmdStr) thenπ      BEGINπ        { then swap the strings }π        tempstr := tempCmdPtr^.cmdstr;           { save temp's string }π        TempCmdPtr^.cmdStr := CheckPtr^.Cmdstr; { assign check's string to tempπ        CheckPtr^.Cmdstr := tempstr;            { assign tempptr's string to chπ      end;π      CheckPtr := Checkptr^.next;               { get a pointer to next node }π    end; { while checkptr }π    TempCmdPtr := TempCmdPtr^.Next;             { get the next compairson base π  end; { while tempcmdptr }πend; { SortListReverse }ππFUNCTION LIST.COMPARE( A, B : String ) : BOOLEAN;πbeginπ  Compare := (CompUCString( A,B ) = Less);πend;πππFUNCTION LIST.FIRSTNAME : String;πBEGINπ  if First <> NIL then beginπ    FirstName := First^.CmdStr;π    Current := First;π  end elseπ    FirstName := '';πEND;ππFUNCTION LIST.LASTNAME : String;πBEGINπ  if Last <> NIL then beginπ    LastName := Last^.CmdStr;π    Current := Last;π  end elseπ    LastName := '';πEND;ππFUNCTION LIST.CURRENTNAME : String;πBEGINπ  if Current <> NIL thenπ    CurrentName := Current^.CmdStrπ  elseπ    CurrentName := '';πEND;ππFUNCTION LIST.NEXTNAME : String;πBEGINπ  if (Current <> NIL) Then beginπ    Current := Current^.Next;π    if (Current <> NIL) thenπ      NextName := Current^.CmdStrπ    elseπ      NextName := '';π  end elseπ    NextName := '';πEND;ππFUNCTION LIST.TOTALCOUNT : Word;πBEGINπ  TotalCount := ListCount;πEND;ππPROCEDURE LIST.CLEARLIST;πBEGINπ  if First <> NIL thenπ    repeatπ      Current := First^.Next;π      Dispose(First);π      First := Current;π    until First = nil;π  Last := First;π  ListCount := 0;πEND;ππFunction List.InList(Name:String; CheckCase : Boolean) : Boolean;π{ returns true if string was in list }πVARπ  TempPtr : CmdPtr;π  OK      : Boolean;πBEGINπ  Ok := false;π  TempPtr := Current;π  Current := First;π  If checkCase then OK := (CompString(FirstName,Name) = Equal)π  Else Ok := (CompUCString(FirstName,Name) = Equal);π  If Not OK thenπ  BEGINπ    While (Current <> Nil) AND Not OK DOπ    If CheckCase then OK := (CompString(NextName,Name) = Equal)π    Else OK := (CompUCString(NextName,Name) = Equal);π  end;π  InList := OK;π  Current := TempPtr;πend;ππDESTRUCTOR LIST.DONE;πBEGINπ  ClearList;πEND;ππBEGINπEND.ππ                                                                                                            3      08-25-9409:10ALL                      [e-mail]    Defining array sizes     SWAG9408    O╛╝8    35     d   {π RJS> Just a quick question... In the variable declaration field, you defineπ RJS> an array with array [0..9] of foo, But let's say I didn't know exactlyπ RJS> how big the array was going to be... How would I declare an array withπ RJS> a variable endpoint?ππThere are a couple of ways around this, and they employ the use of pointers,πwhich in turn, require a little additional code to maintain. If you are useingπBorlands Pascal 6 or 7, the tCollection objects work quite well, or else makeπuse of linked lists. There is still the option of using a variable lengthedπarray too.ππAs an example,π}π{$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}π{$M 16384,0,655360}πProgram VariableArrayETC;πuses objects;πTypeπ   Data = Recordπ            name : string[80];π            age  : integer;π          end;ππ  VArray = array[0..0] of Data;   {variable sized array}π  VAPtr  = ^Varray;ππ  VLPtr = ^VList;                 {linked list}π  VList = Recordπ            rec : Data;π            next,π            prev: VLPtr;π          end;ππ  DataPtr = ^data;                {OOP types from the objects unit}π  VObj    = Object(tCollection)π              procedure FreeItem(item:pointer); virtual;π            end;π  VObjPtr = ^VObj;π              Procedure VObj.FreeItem(item:pointer);π                 beginπ                   dispose(DataPtr(item));π                 end;πππprocedure MakeTestFile;π   var i:integer;π       f:file of Data;π       d:data;π   Beginπ     writeln;π     writeln('blank name will exit');π     assign(f,'test.dat');π     rewrite(f);π     fillchar(d,sizeof(d),0);π     repeatπ       write('name : '); readln(d.name);π       if   d.name <> ''π       then beginπ              repeatπ                write('age : '); readln(d.age);π              until ioresult = 0;π              write(f,d);π            end;π     until d.name = '';π     close(f);π   End;ππProcedure VariableArrayExample; {turn Range Checking off...}π   var f:file;π       v:VAPtr;π       i,res:integer;π       d:data;π       m:longint;π   Beginπ     writeln;π     Writeln('output of variable array ... ');π     m := memavail;π     assign(f,'test.dat');π     reset(f,sizeof(data));π     getmem(v,filesize(f)*SizeOf(Data));π     blockRead(f,v^,filesize(f),res);π     for i := 0 to res - 1 doπ        beginπ          writeln(v^[i].name);π          writeln(v^[i].age);π        end;π     freemem(v,filesize(f)*SizeOf(Data));π     close(f);π     if m <> memavail then writeln('heap ''a trouble...');π   End;ππProcedure LinkedListExample;π   var f:file of Data;π       curr,hold : VLPtr;π       m:longint;π   Beginπ     curr := nil; hold := nil;π     writeln;π     writeln('Linked List example ... ');π     m := memavail;π     assign(f,'test.dat');π     reset(f);π     while not eof(f) doπ        beginπ          new(curr);π          curr^.prev := hold;π          read(f,curr^.rec);π          curr^.next := nil;π          if hold <> nil then hold^.next := curr;π          hold := curr;π        end;π    close(f);π    hold := curr;π    if   hold <> nilπ    then beginπ           while hold^.prev <> nil do hold := hold^.prev;π           while hold <> nil doπ           beginπ             writeln(hold^.rec.name);π             writeln(hold^.rec.age);π             hold := hold^.next;π           end;π           hold := curr;π           while hold <> nil doπ             beginπ               hold := curr^.prev;π               dispose(curr);π               curr := hold;π             end;π         end;π    if m <> memavail then writeln('heap ''a trouble...');π  End;ππProcedure tCollectionExample;  {requires the object unit}π   var p:VObjPtr;π       d:DataPtr;π       f:file of Data;π       m:longint;π   procedure WriteEm(dp:DataPtr); far;π      beginπ        writeln(dp^.name);π        writeln(dp^.age);π      end;π   beginπ     writeln;π     writeln('object tCollection example ... ');π     m := memavail;π     assign(f,'test.dat');π     new(p,init(5,2));π     reset(f);π     while not eof(f) doπ        beginπ          new(d);π          system.read(f,d^);π          p^.insert(d);π        end;π     close(f);π     p^.forEach(@WriteEm);π     dispose(p,done);π     if m <> memavail then writeln('heap ''a trouble...');π  end;πππBeginπ  maketestfile;π  variablearrayexample;π  linkedListExample;π  tcollectionExample;πEnd.ππ                                            4      08-26-9408:32ALL                      DANNY THORPE             Clock on Menubar         SWAG9408    Oßï    95     d   unit clocks;π{$X+}  {allow discardable function results}ππ{ Clock-on-a-menubar OOP extension to Turbo Vision appsππ  Copyright (c) 1990 by Danny Thorpeππ  Alarms have not been implemented.π}ππinterfaceπuses dos, objects, drivers, views, menus, dialogs, app, msgbox;ππconst  cmClockChangeDisplay = 1001;π       cmClockSetAlarm = 1002;ππ       ClockNoSecs   = 0;π       ClockDispSecs = 1;π       Clock12hour   = 0;π       Clock24hour   = 1;ππtypeππ     ClockDataRec = recordπ       Format: word;π       Seconds: word;π       RefreshStr: String[2];π       end;πππ     PClockMenu = ^TClockMenu;π     TClockMenu = object(TMenuBar)π       ClockOptions: ClockDataRec;π       Refresh: byte;π       LastTime: DateTime;π       TimeStr: string[10];π       constructor Init(var Bounds: TRect; Amenu: PMenu);π       procedure Draw;   virtual;π       procedure Update; virtual;π       procedure SetRefresh(Secs: integer);        virtual;π       procedure SetRefreshStr( Secs: string);     virtual;π       procedure ClockChangeDisplay;               virtual;π       procedure HandleEvent( var Event: TEvent);  virtual;π       function  FormatTimeStr(h,m,s:word):string; virtual;π       end;πππππimplementationπππfunction LeadingZero(w : Word) : String;πvarπ  s : String;πbeginπ  Str(w:0,s);π  if Length(s) = 1 thenπ    s := '0' + s;π  LeadingZero := s;πend;ππππconstructor TClockMenu.Init(var Bounds: TRect; AMenu: PMenu);π  var Temp: PMenuBar;π      ClockMenu: PMenu;π      R: TRect;π  beginπ  ClockMenu:= NewMenu(NewSubMenu('~'#0'~Clock ', hcNoContext, NewMenu(π                NewItem('~C~hange display','',0,cmClockChangeDisplay, hcNoContext,π                NewItem('Set ~A~larm','', 0, cmClockSetAlarm, hcNoContext,π                nil))),π                AMenu^.Items));π                { ^^ tack passed menubar on end of new clock menu }π  ClockMenu^.Default:= AMenu^.Default;ππ  TMenuBar.Init(Bounds, ClockMenu);ππ  fillchar(LastTime,sizeof(LastTime),#$FF);   {fill with 65000's}π  TimeStr:='';π  ClockOptions.Format:= Clock24Hour;π  ClockOptions.Seconds:= ClockDispSecs;π  SetRefresh(1);π  end;ππππprocedure TClockMenu.Draw;π  var P: PMenuItem;π  beginπ  P:= FindItem(#0);π  if P <> nil thenπ    beginπ    DisposeStr(P^.Name);π    P^.Name:= NewStr('~'#0'~'+TimeStr);π    end;π  TMenuBar.Draw;π  end;ππππprocedure TClockMenu.Update;π  var h,m,s,hund: word;π  beginπ    GetTime(h,m,s,hund);π    if abs(s-LastTime.sec) >= Refresh thenπ      beginπ      with LastTime doπ        beginπ        Hour:=h;π        Min:=m;π        Sec:=s;π        end;π      TimeStr:= FormatTimeStr(h,m,s);π      DrawView;π      end;π  end;πππππprocedure TClockMenu.SetRefresh(Secs: integer);π  beginπ  if Secs > 59 thenπ    Secs := 59;π  if Secs < 0 thenπ    Secs := 0;π  Refresh:= Secs;π  Str(Refresh:2,ClockOptions.RefreshStr);π  end;ππππprocedure TClockMenu.SetRefreshStr( Secs: string);π  var temp,code: integer;π  beginπ  val(Secs, temp, code);π  if code = 0 thenπ    SetRefresh(temp);π  end;πππππprocedure TClockMenu.ClockChangeDisplay;ππ  varπ    D: PDialog;π    Control: PView;π    Command: word;π    temp,code: integer;π    R: TRect;π    ClockData : ClockDataRec;ππ  beginππ  ClockData := ClockOptions;ππ  R.Assign(14,3,48,15);π  D:= new(PDialog, Init(R, 'Clock Display'));ππ  R.Assign(3,3,20,5);π  Control:= new(PRadioButtons, Init(R,π            NewSItem('~1~2 hour',π            NewSItem('~2~4 hour',π            nil))));π  D^.Insert(Control);ππ  R.Assign(3,2,20,3);π  Control:= new(Plabel, Init(R, '~F~ormat', Control));π  D^.Insert(Control);ππ  R.Assign(3,6,20,7);π  Control:= new(PCheckBoxes, Init(R,π            NewSItem('~S~econds',π            nil)));π  D^.Insert(Control);ππ  R.Assign(16,9,20,10);π  Control:= new(PInputLine, Init(R, 2));π  D^.Insert(Control);ππ  R.Assign(2,8,20,9);π  Control:= new(PLabel, Init(R, '~R~efresh Rate', Control));π  D^.Insert(Control);ππ  R.Assign(2,9,15,10);π  Control:= new(PLabel, Init(R, '0-59 seconds', PLabel(Control)^.Link));π  D^.Insert(Control);ππ  R.Assign(21,3,31,5);π  Control:= new(PButton, Init(R, '~O~k', cmOk, bfDefault));π  D^.Insert(Control);ππ  R.Assign(21,6,31,8);π  Control:= new(PButton, Init(R, '~C~ancel', cmCancel, bfNormal));π  D^.Insert(Control);πππ  D^.SelectNext(False);π  D^.SetData(ClockData);π  repeatπ    Command:= Desktop^.ExecView(D);π    if Command = cmOK thenπ      beginπ      D^.GetData(ClockData);π      val(ClockData.RefreshStr,temp,code);π      if (code <> 0) or ((temp<0) or (temp>59)) thenπ        MessageBox('Refresh rate must be between 0 and 59 seconds.',nil,π           mfOKButton+mfError);π      end;π  until (Command = cmCancel)π     or ((code=0) and ((temp>=0) and (temp<=59)));ππ  Dispose(D, Done);ππ  if Command = cmOk thenπ    beginπ    ClockOptions:= ClockData;π    SetRefreshStr(ClockData.RefreshStr);π    end;ππ  { update display to reflect changes immediately }π  TimeStr:= FormatTimeStr(LastTime.hour, LastTime.min, LastTime.sec);π  DrawView;π  end;ππππππprocedure TClockMenu.HandleEvent( var Event: TEvent);π  beginπ  TMenuBar.HandleEvent( Event);π  if Event.What = evCommand thenπ    beginπ    case Event.Command ofπ      cmClockChangeDisplay: ClockChangeDisplay;π      cmClockSetAlarm: ;π      end;π    end;π  end;πππππfunction TClockMenu.FormatTimeStr(h,m,s: word): string;π  var st, tail: string;π  beginπ  tail:='';π  if ClockOptions.Format = Clock24Hour thenπ    st:= LeadingZero(h)π  elseπ    beginπ    if h >= 12 thenπ      beginπ      tail:= 'pm';π      if h>12 thenπ        dec(h,12);π      endπ    elseπ      tail:= 'am';π    if h=0 then h:=12;   {12 am}π    str(h:0,st);    { no leading space on hours }π    end;ππ  st:=st+':'+ LeadingZero(m);πππ  if ClockOptions.Seconds = ClockDispSecs thenπ    st:= st+':'+LeadingZero(s);ππ  FormatTimeStr:= st + tail;π  end;πππππend.ππ{ ----------------------------- DEMO  ---------------------- }ππprogram TestPlatform;ππuses Objects, Drivers, Views, Menus, App,π     Dos,     { for the paramcount and paramstr funcs}π     Clocks;  { for the clock on the menubar object, TClockMenu }ππ{ This generic test platform has been hooked up to the clock-on-the-menubarπ  object / unit.  Search for *** to find hook-up points.ππ  Copyright (c) 1990 by Danny Thorpeπ}πππconst  cmNewWin =   100;π       cmFileOpen = 101;ππ       WinCount : Integer = 0;π       MaxLines = 50;πππtype  PInterior = ^TInterior;π      TInterior = object(TScroller)π        constructor init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);π        procedure Draw;  virtual;π        end;πππ      PDemoWindow = ^TDemoWindow;π      TDemoWindow = object(TWindow)π        constructor Init(WindowNo: integer);π        end;πππ      TMyApp = object(TApplication)π        procedure InitStatusLine;  virtual;π        procedure InitMenuBar;  virtual;π        procedure NewWindow;π        procedure HandleEvent( var Event: TEvent); virtual;π        procedure Idle; virtual;π        end;πππvar MyApp: TMyApp;π    Lines: array [0..MaxLines-1] of PString;π    LineCount: Integer;πππconstructor TInterior.Init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);π  beginπ  TScroller.Init(Bounds,AHScrollbar,AVScrollbar);π  Growmode := gfGrowHiX + gfGrowHiY;π  Options := Options or ofFramed;π  SetLimit(128,LineCount);π  end;πππprocedure TInterior.Draw;π  var color: byte;π      y,i: integer;π      B: TDrawBuffer;ππ  beginπ  TScroller.Draw;π  Color := GetColor($01);π  for y:= 0 to Size.Y -1 doπ    beginπ    MoveChar(B,' ',Color,Size.X);π    I := Delta.Y + Y;π    if (I<Linecount) and (Lines[I] <> nil) thenπ      MoveStr(B,Copy(Lines[I]^,Delta.X+1,size.x),Color);π    WriteLine(0,y,size.x,1,B);π    end;π  end;πππprocedure ReadFile;π  var  F: text;π       S: string;ππ  beginπ  LineCount:=0;π  if paramcount = 0 thenπ    assign(F,'clockwrk.pas')π  elseπ    assign(F,paramstr(1));π  reset(F);π  while not eof(F) and (linecount < maxlines) doπ    beginπ    readln(f,s);π    Lines[Linecount] := NewStr(S);π    Inc(LineCount);π    end;π  Close(F);π  end;ππππππconstructor TDemoWindow.Init(WindowNo: Integer);π  var  LInterior, RInterior: PInterior;π       HScrollbar, VScrollbar: PScrollbar;π       R: TRect;π       Center: integer;ππ  beginπ    R.Assign(0,0,40,15);π    R.Move(Random(40),Random(8));ππ    TWindow.Init(R, 'Window', wnNoNumber);π    GetExtent(R);π    Center:= (R.B.X + R.A.X) div 2;π    R.Assign(Center,R.A.Y+1,Center+1,R.B.Y-1);π    VScrollbar:= new(PScrollbar, Init(R));π    with VScrollbar^ do Options := Options or ofPostProcess;π    Insert(VScrollbar);π    GetExtent(R);π    R.Assign(R.A.X+2,R.B.Y-1,Center-1,R.B.Y);π    HScrollbar:= new(PScrollbar, Init(R));π    with HScrollbar^ do Options := Options or ofPostProcess;π    Insert(HScrollbar);π    GetExtent(R);π    R.Assign(R.A.X+1,R.A.Y+1,Center,R.B.Y-1);π    LInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));π    with LInterior^ doπ      beginπ      Options:= Options or ofFramed;π      Growmode:= GrowMode or gfGrowHiX;π      SetLimit(128,LineCount);π      end;π    Insert(LInterior);ππ    GetExtent(R);π    R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1);π    VScrollbar:= new(PScrollbar, Init(R));π    with VScrollbar^ do Options := Options or ofPostProcess;π    Insert(VScrollbar);π    GetExtent(R);π    R.Assign(Center+2,R.B.Y-1,R.B.X-2,R.B.Y);π    HScrollbar:= new(PScrollbar, Init(R));π    with HScrollbar^ doπ      beginπ      Options := Options or ofPostProcess;π      GrowMode:= GrowMode or gfGrowLoX;π      end;π    Insert(HScrollbar);π    GetExtent(R);π    R.Assign(Center+1,R.A.Y+1,R.B.X-1,R.B.Y-1);π    RInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));π    with RInterior^ doπ      beginπ      Options:= Options or ofFramed;π      Growmode:= GrowMode or gfGrowLoX;π      SetLimit(128,LineCount);π      end;π    Insert(RInterior);π    end;πππππprocedure TMyApp.InitStatusLine;π  var R: TRect;ππ  beginπ  GetExtent(R);      { find out how big the current view is }π  R.A.Y := R.B.Y-1;  { squeeze R down to one line at bottom of frame }π  StatusLine := New(PStatusline, Init(R,π                  NewStatusDef(0, $FFFF,π                    NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,π                    NewStatusKey('~F4~ New', kbF4, cmNewWin,π                    NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,π                    nil))),π                  nil)π                ));π  end;πππ{ *** The vvv below indicate the primary hook-up point for the menubar-clock.π  This programmer-defined normal menu structure will be tacked onto theπ  end of the clock menubar in TClockMenu.Init.π}ππprocedure TMyApp.InitMenuBar;π  var R: TRect;ππ  beginπ  GetExtent(R);       {***}π  r.b.y:= r.a.y+1;   { vvv }π  Menubar := New(PClockMenu, Init(R, NewMenu(π               NewSubMenu('~F~ile', hcNoContext, NewMenu(π                 NewItem('~O~pen','F3', kbF3, cmFileOpen, hcNoContext,π                 NewItem('~N~ew','F4', kbF4, cmNewWin, hcNoContext,π                 NewLine(π                 NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcNoContext,π                 nil))))),π               NewSubMenu('~W~indow', hcNoContext, NewMenu(π                 NewItem('~N~ext','F6', kbF6, cmNext, hcNoContext,π                 NewItem('~Z~oom','F7', kbF7, cmZoom, hcNoContext,π                 nil))),π               nil))    { one ) for each menu defined }π             )));π  end;πππprocedure TMyApp.NewWindow;π  varπ    Window: PDemoWindow;π    R: TRect;ππ  beginπ  inc(WinCount);π  Window:= New(PDemoWindow, Init(WinCount));π  Desktop^.Insert(Window);π  end;πππππ{*** clock hook-up point - typecasting required to access "new" method }ππprocedure TMyApp.Idle;π  beginπ  TApplication.Idle;π  PClockMenu(MenuBar)^.Update;π  end;πππππprocedure TMyApp.HandleEvent( var Event: TEvent);π  beginπ  TApplication.HandleEvent(Event);π  if Event.What = evCommand thenπ    beginπ      case Event.Command ofπ        cmNewWin: NewWindow;π      else  { case }π        Exit;π      end;  { case }π      ClearEvent(Event);π    end; {if}π  end;πππππππππbeginππreadfile;ππMyApp.Init;πMyApp.run;πMyApp.done;πend.π                                                    5      08-26-9408:32ALL                      SWAG SUPPORT TEAM        Change T.V. Colors       SWAG9408    ?G    39     d   program Color;ππ{$R color.res }ππusesπ  WinProcs,π  WinTypes,π  WObjects;ππconstπ  White        = $00FFFFFF;π  Black        = $00000000;π  LightGray    = $00C0C0C0;π  DarkGray     = $00808080;π  Cyan         = $00FFFF00;π  Magenta      = $00FF00FF;π  Yellow       = $0000FFFF;π  Red          = $000000FF;π  Green        = $0000FF00;π  Blue         = $00FF0000;π  LightBlue    = $00800000;π  LightCyan    = $00808000;π  LightMagenta = $00800080;π  Brown        = $00008080;π  LightRed     = $00000080;π  LightGreen   = $00008000;ππconstπ  id_Color = 101;ππtypeπ  PColorDialog = ^TColorDialog;π  TColorDialog = object(TDialog)π    ColorPtr : ^longint;π    constructor Init(AParent : PWindowsObject; var AColor : longint);π    procedure SetupWindow; virtual;π    function CanClose : boolean; virtual;π    procedure wmDrawItem(var Msg : TMessage); virtual wm_First+wm_DrawItem;π    procedure wmMeasureItem(var Msg : TMessage); virtual wm_First+wm_MeasureItem;π  end;ππconstructor TColorDialog.Init(AParent : PWindowsObject; var AColor : longint);πbeginπ  TDialog.Init(AParent,'ColorDlg');π  ColorPtr := @AColor;πend; { Init }ππprocedure TColorDialog.SetupWindow;πconstπ  NColors = 16;π  StdColors : array[1..NColors] of longint =π   (White, Black, LightGray, DarkGray, Cyan, Magenta, Yellow, Red, Green,π    Blue, LightBlue, LightCyan, LightMagenta, Brown, LightRed, LightGreen);ππ  procedure SetupColors(ID : integer; Color : longint);π  varπ    i,Sel : integer;π  beginπ    Sel := -1;π    for i := 1 to NColors do beginπ      SendDlgItemMsg(ID,cb_AddString,0,StdColors[i]);π      if StdColors[i] = Color then Sel := pred(i);π    end;π    if Sel = -1 then beginπ      SendDlgItemMsg(ID,cb_AddString,0,Color);π      Sel := NColors;π    end;π    SendDlgItemMsg(ID,cb_SetCurSel,Sel,0);π  end; { SetupColors }ππbegin { SetupWindow }π  TDialog.SetupWindow;π  SetupColors(id_Color,ColorPtr^);πend; { SetupWindow }ππfunction TColorDialog.CanClose : boolean;ππ  procedure GetCol(ID : integer; var Color : longint);π  varπ    Sel : integer;π  beginπ    Sel := SendDlgItemMsg(ID,cb_GetCurSel,0,0);π    if Sel > -1 thenπ      SendDlgItemMsg(ID,cb_GetLBText,Sel,longint(@Color));π  end; { GetCol }ππbegin { CanClose }π  GetCol(id_Color,ColorPtr^);π  CanClose := true;πend; { CanClose }πππprocedure TColorDialog.wmDrawItem(var Msg : TMessage);πvarπ  Brush : HBrush;πbeginπ  with PDrawItemStruct(Msg.lParam)^ do beginπ    if CtlType = odt_ComboBox then beginπ      if ((ItemAction and oda_DrawEntire) <> 0) orπ         ((ItemAction and oda_Select) <> 0) then beginπ        Brush := CreateSolidBrush(ItemData);π        FillRect(hDC,rcItem,Brush);π        DeleteObject(Brush);π      end;π      if ((ItemState and ods_Focus) <> 0) orπ         ((ItemState and ods_Selected) <> 0) then beginπ        InflateRect(rcItem,-2,-2);π        DrawFocusRect(hDC,rcItem);π      end;π    end;π  end;πend; { wmDrawItem }ππprocedure TColorDialog.wmMeasureItem(var Msg : TMessage);πbeginπ  PMeasureItemStruct(Msg.lParam)^.ItemHeight := 16;πend; { wmMeasureItem }ππconstπ  cm_Color = 100;ππtypeπ  PColorWindow = ^TColorWindow;π  TColorWindow = object(TWindow)π    Color : longint;π    constructor Init;π    procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;π    procedure CMColor(var Msg: TMessage);π      virtual cm_First + cm_Color;π  end;ππconstructor TColorWindow.Init;πbeginπ  Color := White;π  TWindow.Init(nil, 'Color Combo Demo');π  Attr.Menu := LoadMenu(HInstance, 'Menu');πend; { Init }ππprocedure TColorWindow.cmColor(var Msg: TMessage);πbeginπ  if Application^.ExecDialog(π       New(PColorDialog,Init(@Self,Color))) = id_Ok thenπ    InvalidateRect(HWindow,nil,true);πend; { cmColor }ππprocedure TColorWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);πvarπ  Brush : HBrush;πbeginπ  Brush := CreateSolidBrush(Color);π  FillRect(PaintDC,PaintInfo.rcPaint,Brush);π  DeleteObject(Brush);πend; { Paint }ππtypeπ  TColorApp = object(TApplication)π    procedure InitMainWindow; virtual;π  end;ππprocedure TColorApp.InitMainWindow;πbeginπ  MainWindow := New(PColorWindow,Init);πend; { InitMainWindow }ππvarπ  ColorApp: TColorApp;ππbeginπ  ColorApp.Init('Menu');π  ColorApp.Run;π  ColorApp.Done;πend.ππ{ -------------------------  COLOR.RES ----------------------- }ππ{ USE XX3402 to decode the following block                              }π{ Cut out and name COLOR.XX.  Use XX3402 d COLOR.XX to create COLOR.RES }ππ{ ------------------------    CUT -----------------------------}ππ*XX3402-000206-140792--72--85-25021-------COLOR.RES--1-OF--1πzkE+HIJCJE+k2+w+++++++++U+-Y+0N1PqljQU1z-E-1HolDIYFAFk+k25I+++1++AW+-3Q+π7U-l+2s+++-1O4xjQqIUMqxgPr6+0+-6NKlq++Q+0E+M++c+zzw+++-EUYBjP4xmCU++6++4π+-s+D+-Z+-A+6J03++-4++M+6k+A++2++E+-I6-DOk++FU+N+0A+1++0+++++J0+Eq3iMqJgπ++1z1k1z+E+k2-s++++A++E++M++HIJCJE+E++I++c++EoxAHp72H2Q+++++π***** END OF BLOCK 1 *****ππ